module Main where

import Network.PGI
import Network.PGI.Handlers
import TNET
import System.IO
import Data.Char
import Numeric
import qualified Data.ByteString.Char8 as B
import Control.Applicative ((<$>))

echoHandler :: TValue -> TValue
echoHandler request =
  bodyData $ dict [ "request" .= request,
                    "title"   .= "simple get" ]

echoHandler1 :: Handler
echoHandler1 = makeHandler echoHandler

echoHandler2 :: Handler
echoHandler2 = makeHandler echoHandler

echoHandler3 :: Handler
echoHandler3 = makeHandler echoHandler

echoHandler4 :: Handler
echoHandler4 = makeHandler echoHandler

indexHandler :: Handler
indexHandler = constHandler $ bodyData $
  dict [
    "haskell_examples" .= [
       dict [ "url" .= "haskell/get", "anchor" .= "GET" ],
       dict [ "url" .= "haskell/get?a=1&b=2",
              "anchor" .= "GET with query params" ],
       dict [ "url" .= "haskell/get/2012/01/03/?a=1&b=2",
              "anchor" .= "GET with groups and query params" ],
       dict [ "url" .= "haskell/get3?a=1&b=2",
              "anchor" .= "GET with CGI vars" ],
       dict [ "url" .= "haskell/unflattened/2012/01/03/?a=1&b=2",
              "anchor" .= "GET unflattened" ],
       dict [ "url" .= "haskell/unicode",
              "anchor" .= "Unicode Strings" ],
       dict [ "url" .= "haskell/data",
              "anchor" .= "Using data file in Bundle()" ],
       dict [ "url" .= "haskell/message",
              "anchor" .= "Message in JSON (default)" ],
       dict [ "url" .= "haskell/message?__format=tnet",
              "anchor" .= "Message in TNET" ],
       dict [ "url" .= "haskell/form",
              "anchor" .= "Form to make POSTs" ],
       dict [ "url" .= "haskell/form?charset=ISO-8859-1",
              "anchor" .= "Form to make POSTs (latin1)" ],
       dict [ "url" .= "haskell/disk-file",
              "anchor" .= "File output example" ],
       dict [ "url" .= "haskell/raw-output",
              "anchor" .= "Raw output example" ],
       dict [ "url" .= "haskell/crash",
              "anchor" .= "Haskell code with unhandled exception" ],
       dict [ "url" .= "haskell/empty",
              "anchor" .= "Empty response" ],
       dict [ "url" .= "haskell/RawBodyBadType",
              "anchor" .= "raw_body is dict instead of string" ],
       dict [ "url" .= "haskell/BadStatus",
              "anchor" .= "Status is wrong type" ],
       dict [ "url" .= "haskell/BadHeaders",
              "anchor" .= "Headers are wrong type" ],
       dict [ "url" .= "haskell/missing-file",
              "anchor" .= "Response refers to a file that it doesn't write" ]
     ]
  ]

makeCharacterRow :: Char -> TValue
makeCharacterRow c =
  let codePoint = ord c
      htmlCharRef = "&#" ++ (show codePoint) ++ ";"
      codePointHex = "U+" ++ showHex codePoint ""
  in dict [ "char" .= c
          , "code_point" .= codePointHex
          , "html_char_ref" .= htmlCharRef
          ]

unicodeHandler :: Handler
unicodeHandler = constHandler $ bodyData $
  let chars = [ '\x00B5' -- mu: less than 0xFF
              , '\x0160' -- S accented: more than 0xFF
              , '\x5165' -- chinese char: utf-8 3-byte range
              ]
  in dict [ "chars" .= map makeCharacterRow chars ]

dataHandler :: Handler
dataHandler = constHandlerM $ do
  contents <- readFile "data/names.csv"
  return . bodyData $ dict [ "contents" .= contents ]

messageHandler :: Handler
messageHandler = constHandler $ dict [ "message" .= dict [ "greeting" .= "hello" ] ]

postEchoHandler :: Handler
postEchoHandler = makeHandler helper
  where
    helper :: TValue -> TValue
    helper req = bodyData $ dict [ "request" .= req, "title" .= "simple get" ]

data FormInfo = FormInfo {
                  fCharSet :: Maybe String
                , fDest    :: Maybe String
                , fReq     :: TValue
                }

instance TNET FormInfo where
  toTNET = undefined
  fromTNET tval = do
    let charSet  = B.unpack <$> tval .: "charset"
    let dest     = B.unpack <$> tval .: "dest"
    let req      = tval
    return $ FormInfo charSet dest tval

handleFormInfo :: FormInfo -> TValue
handleFormInfo (FormInfo charSet dest req) =
  let contentType =
        case charSet of
          Nothing -> "text/html"
          Just cs -> "text/html; charset=" ++ cs
      body = dict [ "request" .= req,
                    "action" .= case dest of
                                  Nothing -> ""
                                  Just v  -> v]
  in dict [ "headers" .= dict [ "Content-Type" .= contentType ],
            "body_data" .= body ]

formHandler = makeHandler handleFormInfo

diskBody :: String
diskBody =
  unlines [ "This file was written to disk by the PGI process. The name of"
          , "that file is returned in the response under \"body_filename\"."
          , ""
          , "The Poly server reads that disk file and returns it as the HTTP"
          , "response body."
          , ""
          , "(A typical usage for this would be for the applet to run a"
          , "command line program that writes a .png file -- that was you"
          , "avoid reading the .png file in the applet process, only to"
          , "have to send it to the server)"
          ]

diskFileOutputHandler :: Handler
diskFileOutputHandler _ = do
  let body = dict [ "title" .= "disk file" ]
  writeFile "tmp.txt" diskBody
  return $ dict [ "raw_body_filename" .= "tmp.txt" ]

rawBody :: String
rawBody = "Raw response, no template.  " ++
          "Also sets Content-Type: text/plain header."

rawOutputHandler = constHandler $
  dict [ "headers" .= dict [ "Content-Type" .= "text/plain" ],
         "raw_body" .= rawBody ]

crashHandler :: Handler
crashHandler req =
  error "Requested crash"

emptyResponseHandler :: Handler
emptyResponseHandler = constHandler $ dict []

rawBodyBadTypeHandler :: Handler
rawBodyBadTypeHandler = constHandler $
  dict [ "raw_body" .= dict [ "bad" .= "type" ] ]

badStatusHandler :: Handler
badStatusHandler = constHandler $
  dict [ "status" .= (404.0 :: Double), "raw_body" .= "hi" ]

badHeadersHandler :: Handler
badHeadersHandler = constHandler $
  dict [ "status" .= ["yo"], "headers" .= (200 :: Integer),
         "raw_body" .= "hi" ]

missingFileHandler :: Handler
missingFileHandler = constHandler $
  dict [ "status" .= (200 :: Integer),
         "raw_body_filename" .= "nonexistant.txt" ]

data UploadInfo = UploadInfo {
                    uUpload :: Maybe TValue
                  , uFilename :: Maybe String
                  }

instance TNET UploadInfo where
  toTNET = undefined
  fromTNET tval = do
    upload <- tval .: "upload"
    filename <- tval .: "body_filename"
    return $ UploadInfo upload filename

uploadInfoHandler :: UploadInfo -> IO TValue
uploadInfoHandler (UploadInfo upload filename)  =
  case upload of
    Nothing -> error "Expected 'upload'"
    Just u ->
      case filename of
        Nothing -> error "'upload_field' should be a file"
        Just f -> do
          contents <- readFile f
          return . bodyData $  dict [ "upload" .= u, "contents" .= contents ]

uploadHandler :: Handler
uploadHandler = makeHandlerM uploadInfoHandler

main :: IO ()
main = serve [ ("GetEcho", echoHandler1)
             , ("GetEcho2", echoHandler2)
             , ("GetEcho3", echoHandler3)
             , ("GetEcho4", echoHandler4)
             , ("Index", indexHandler)
             , ("Unicode", unicodeHandler)
             , ("Data", dataHandler)
             , ("Message", messageHandler)
             , ("PostEcho", postEchoHandler)
             , ("Form", formHandler)
             , ("DiskFileOutput", diskFileOutputHandler)
             , ("RawOutput", rawOutputHandler)
             , ("Crash", crashHandler)
             , ("EmptyResponse", emptyResponseHandler)
             , ("RawBodyBadType", rawBodyBadTypeHandler)
             , ("BadStatus", badStatusHandler)
             , ("BadHeaders", badHeadersHandler)
             , ("MissingFile", missingFileHandler)
             , ("Upload", uploadHandler)
             ]
